home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / himath.zip / MATHDEMO.BAS < prev    next >
BASIC Source File  |  1991-10-04  |  25KB  |  639 lines
  1. '***************************************************************************
  2. '**** MATHDEMO.BAS Test Kevin Jorgensen's "HIMATH" Library
  3. '***************************************************************************
  4. DEFDBL A-Z
  5. CONST Pi = 3.141592653589793#
  6. CONST HalfPi = Pi / 2#
  7. CONST TwoPi = Pi * 2#
  8.  
  9. TYPE VRect         'User type for 3d Vector Math
  10.   x AS DOUBLE
  11.   y AS DOUBLE
  12.   z AS DOUBLE
  13. END TYPE
  14.  
  15. TYPE XRect         'User Type for Complex Numbers
  16.   i AS DOUBLE
  17.   j AS DOUBLE
  18. END TYPE
  19.  
  20.  
  21. '======================================================================
  22. 'Math Demo Routines
  23. '======================================================================
  24. DECLARE SUB TestHold ()
  25. DECLARE SUB TestMatrix1 ()
  26. DECLARE SUB TestMatrix2 ()
  27. DECLARE SUB TestMatrixLoad (GivenMtx#(), A$)
  28. DECLARE SUB TestMatrixPrint (MtxErr%, Mtx())
  29. DECLARE SUB TestInvTrig ()
  30. DECLARE SUB TestTriangle ()
  31. DECLARE SUB TestTriangle2 (s$, p1#, p2#, p3#)
  32. DECLARE SUB TestVector ()
  33. DECLARE SUB TestVectorLoad (GivenVctr AS ANY, A$)
  34. DECLARE SUB TestVectorPrint (GivenVctr AS ANY)
  35. DECLARE SUB TestXmath ()
  36. DECLARE SUB TestXMatrix1 ()
  37. DECLARE SUB TestXMatrix2 ()
  38. DECLARE SUB TestXMatrixLoad (GivenMtx() AS XRect, A$)
  39. DECLARE SUB TestXMatrixPrint (MtxErr%, Mtx() AS XRect)
  40.  
  41. '======================================================================
  42. '======================================================================
  43. 'Demo'd in TestInvTrig
  44.   DECLARE FUNCTION ACOS (x)
  45.   DECLARE FUNCTION ASIN (y)
  46.   DECLARE FUNCTION ATAN2 (x, y)
  47.  
  48. 'Demo'd in TestTriangle
  49.   DECLARE SUB TriangleSolve (ProbType$, p1, p2, p3, A(), s(), NbrOfSolutions%)
  50.  
  51. 'Demo'd in TestMatrix1
  52.   DECLARE SUB MtxCoeff (MtxErr%, Mtx(), Vctr(), Coeff())
  53.   DECLARE SUB MtxCoeffA (MtxErr%, Mtx())
  54.   DECLARE SUB MtxCopy (MtxErr%, Src(), Dst())
  55.   DECLARE FUNCTION MtxDet (MtxErr%, Mtx())
  56.  
  57. 'Demo'd in TestMatrix2
  58.   DECLARE SUB MtxAdd (MtxErr%, A(), B(), C())
  59.   DECLARE SUB MtxSub (MtxErr%, A(), B(), C())
  60.   DECLARE SUB MtxInv (MtxErr%, A(), B())
  61.   DECLARE SUB MtxMltS (MtxErr%, A(), B, C())
  62.   DECLARE SUB MtxMltX (MtxErr%, A(), B(), C())
  63.  
  64. 'Demo'd in TestXmath
  65.   DECLARE SUB XCnvP (r, t, Result AS XRect)
  66.   DECLARE SUB XCnvR (i, j, Result AS XRect)
  67.  
  68.   DECLARE FUNCTION XMag (Op1 AS XRect)
  69.   DECLARE FUNCTION XAng (Op1 AS XRect)
  70.   DECLARE FUNCTION XReal (Op1 AS XRect)
  71.   DECLARE FUNCTION XImag (Op1 AS XRect)
  72.  
  73.   DECLARE FUNCTION XFmtP$ (Op1 AS XRect)
  74.   DECLARE FUNCTION XFmtR$ (Op1 AS XRect)
  75.  
  76.   DECLARE SUB XAdd (Op1 AS XRect, Op2 AS XRect, Result AS XRect)
  77.   DECLARE SUB XSub (Op1 AS XRect, Op2 AS XRect, Result AS XRect)
  78.   DECLARE SUB XMlt (Op1 AS XRect, Op2 AS XRect, Result AS XRect)
  79.   DECLARE SUB XDiv (Op1 AS XRect, Op2 AS XRect, Result AS XRect)
  80.   DECLARE SUB XPwr (Op1 AS XRect, Op2, Result AS XRect)
  81.   DECLARE SUB XCnj (Op1 AS XRect, Result AS XRect)
  82.   DECLARE SUB XInv (Op1 AS XRect, Result AS XRect)
  83.  
  84. 'Demo'd in TestXMatrix1
  85.   DECLARE SUB XMtxCoeff (MtxErr%, Mtx() AS XRect, Vctr() AS XRect, Coeff() AS XRect)
  86.   DECLARE SUB XMtxCoeffA (MtxErr%, Mtx() AS XRect)
  87.   DECLARE SUB XMtxCopy (MtxErr%, Src() AS XRect, Dst() AS XRect)
  88.   DECLARE SUB XMtxDet (MtxErr%, XMtx() AS XRect)
  89.  
  90. 'Demo'd in TestXMatrix2
  91.   DECLARE SUB XMtxAdd (MtxErr%, A() AS XRect, B() AS XRect, C() AS XRect)
  92.   DECLARE SUB XMtxInv (MtxErr%, A() AS XRect, Mtx() AS XRect)
  93.   DECLARE SUB XMtxMltS (MtxErr%, A() AS XRect, B AS XRect, C() AS XRect)
  94.   DECLARE SUB XMtxMltX (MtxErr%, A() AS XRect, B() AS XRect, C() AS XRect)
  95.   DECLARE SUB XMtxSub (MtxErr%, A() AS XRect, B() AS XRect, C() AS XRect)
  96.  
  97. 'Demo'd in TestVector
  98.   DECLARE SUB VAdd (Op1 AS VRect, Op2 AS VRect, Result AS VRect)
  99.   DECLARE SUB VMltX (Op1 AS VRect, Op2 AS VRect, Result AS VRect)
  100.   DECLARE SUB VSub (Op1 AS VRect, Op2 AS VRect, Result AS VRect)
  101.   DECLARE FUNCTION VMltD (Op1 AS VRect, Op2 AS VRect)
  102.  
  103. '======================================================================
  104.  
  105.   RANDOMIZE TIMER
  106.   TestInvTrig
  107.   TestTriangle
  108.   TestMatrix1
  109.   TestMatrix2
  110.   TestXmath
  111.   TestXMatrix1
  112.   TestXMatrix2
  113.   TestVector
  114. END
  115.  
  116. '======================================================================
  117. SUB TestHold
  118. '======================================================================
  119.   PRINT "Press Enter to Continue ";
  120.   x = CSRLIN
  121.   DO
  122.   LOOP UNTIL INKEY$ <> ""
  123.   LOCATE x, 1: PRINT SPACE$(40)
  124.  
  125. END SUB
  126.  
  127. '======================================================================
  128. SUB TestInvTrig
  129. '======================================================================
  130.   CLS
  131.   PRINT "SUB TestInvTrig  Demonstrating of ASIN, ACOS, and ATAN functions"
  132.   PRINT
  133.   PRINT "Given --------------------------- Calc'd -------------------"
  134.   PRINT "ang      SIN     COS          TAN     ASIN     ACOS     ATAN"
  135.   PRINT "---  ------- ------- ------------ -------- -------- --------"
  136.   FOR x = 0 TO 360 STEP 30
  137.     t = x / 180 * Pi
  138.     xsin = SIN(t)
  139.     xcos = COS(t)
  140.     xtan = TAN(t)
  141.     ysin = ASIN(xsin) * 180# / Pi
  142.     ycos = ACOS(xcos) * 180# / Pi
  143.     ytan = ATAN2(xcos, xsin) * 180# / Pi
  144.     IF ABS(xtan) >= 0 AND ABS(xtan) < 99999 THEN
  145.       PRINT USING "###  ##.#### ##.#### #####.###### ####.### ####.### ####.###"; x; xsin; xcos; xtan; ysin; ycos; ytan
  146.     ELSE
  147.       PRINT USING "###  ##.#### ##.#### ##.#####^^^^ ####.### ####.### ####.###"; x; xsin; xcos; xtan; ysin; ycos; ytan
  148.     END IF
  149.   NEXT x
  150.   TestHold
  151. END SUB
  152.  
  153. '======================================================================
  154. SUB TestMatrix1
  155. '======================================================================
  156.   Rows% = 8: ColVctr% = Rows% + 1
  157.   DIM ScratchMtx(Rows%, ColVctr%), GivenMtx(Rows%, ColVctr%)
  158.   DIM ScratchMtx2(Rows%, Rows%), Vctr(Rows%), Coeff(Rows%)
  159.   CLS
  160.   PRINT "SUB TestMatrix1  Demonstrating MtxCoeff, MtxCoeffA, MtxCopy, MtxDet"
  161.  
  162.   TestMatrixLoad GivenMtx(), "A"
  163.  
  164. '***************************************************************************
  165. '***************************************************************************
  166.   PRINT "╔══ Calculate Determinant using MtxDet ═════════════════════════════════════"
  167.   MtxCopy MtxErr%, GivenMtx(), ScratchMtx()
  168.   PRINT "║ Determinant = "; MtxDet(MtxErr%, ScratchMtx())
  169.   PRINT "╚═══════════════════════════════════════════════════════════════════════════"
  170.  
  171. '***************************************************************************
  172. '***************************************************************************
  173.   PRINT "╔══ Calculate Coefficients using MtxCoeffA ═════════════════════════════════"
  174.   'The Column Vector Must be in the last colum of the array
  175.   'ie. if the matrix is 5x5, the colum vector should be in column 6
  176.   MtxCopy MtxErr%, GivenMtx(), ScratchMtx()
  177.   MtxCoeffA MtxErr%, ScratchMtx()
  178.   'TestMatrixPrint MtxErr%, ScratchMtx()
  179.   PRINT "║";
  180.   FOR i% = 1 TO Rows%
  181.     PRINT USING " ##.####"; ScratchMtx(i%, ColVctr%);
  182.   NEXT i%
  183.   PRINT
  184.   PRINT "╚═══════════════════════════════════════════════════════════════════════════"
  185.  
  186. '***************************************************************************
  187. '***************************************************************************
  188.   PRINT "╔══ Calculate Coefficients using MtxCoeff ═════════════════════════════════"
  189.   FOR i% = 1 TO Rows%
  190.     Vctr(i%) = GivenMtx(i%, ColVctr%)
  191.   NEXT i%
  192.   MtxCopy MtxErr%, GivenMtx(), ScratchMtx2()
  193.   MtxCoeff MtxErr%, ScratchMtx2(), Vctr(), Coeff()
  194.   PRINT "║";
  195.   FOR i% = 1 TO Rows%
  196.     PRINT USING " ##.####"; Coeff(i%);
  197.   NEXT i%
  198.   PRINT
  199.   PRINT "╚═══════════════════════════════════════════════════════════════════════════"
  200.   TestHold
  201. END SUB
  202.  
  203. '======================================================================
  204. SUB TestMatrix2
  205. '======================================================================
  206.   DIM MtxA(3, 3), MtxB(3, 3), MtxC(3, 3)
  207. '======================================================================
  208.   CLS
  209.   PRINT "SUB TestMatrix2   Demonstrating  MtxAdd"
  210.   TestMatrixLoad MtxA(), "A"
  211.   TestMatrixLoad MtxB(), "B"
  212.   MtxAdd Merr%, MtxA(), MtxB(), MtxC()
  213.   PRINT "╔══ Calculate Sum of two Matrices using MtxAdd ═════════════════════════════"
  214.   TestMatrixPrint Merr%, MtxC()
  215.   PRINT "╚═════════